home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / ibm2hpj.arc / IBM2HPJ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-06-09  |  6.0 KB  |  233 lines
  1. Program IBM2HPj;
  2. {program to translate graphics output intended for an IBM Graphics Printer}
  3. {  so it can be sent to HP Laserjet printer}
  4.  
  5. {written by Sally Sheridan & Mark Lewis, June, 1986}
  6. var
  7.   InFileName : string [20];
  8.   InFile : File of byte;
  9.   SaveBuff : String[120];
  10.   nullstr : String[120];
  11.   savebufx : array [0..120] of byte absolute savebuff;
  12.   Saveflg : Boolean;
  13.   Out : text;
  14.   InBuff : byte;
  15.   EndFile : boolean;
  16.   keep : boolean;
  17.   Dens : integer;
  18.   pix  : Integer;
  19.   pixflg,cflag : Boolean;
  20.   Scans,j : Integer;
  21.  
  22. Procedure ResetHP(xray:boolean);
  23. var ist : string[3];
  24. begin
  25.    Write(out,^['E'); {ESC E  flushes buffer and resets to defaults}
  26.    if xray then
  27.    begin
  28.     str(dens,ist);
  29.     write(out,^['*t'+ist+'R');
  30.     scans:=0;
  31.     pix:=pix+1;
  32.     pixflg:=true;
  33.    end;
  34. end;
  35.  
  36. Procedure InitFiles;
  37. var parambuf  : string[16];
  38.     parampt,j : Integer;
  39.   begin
  40.      keep:=false;  {set defaults}
  41.      dens:=100;
  42.      cflag:=false;
  43.      If paramCount>0 then
  44.      begin
  45.        for parampt := 1 to paramcount do
  46.        begin
  47.           parambuf:=paramstr(parampt);
  48.           if (parambuf[1]='-') then
  49.           begin
  50.            for j:=2 to length(parambuf) do
  51.            begin
  52.              if ((parambuf[j]='k') or (parambuf[j]='K')) then keep:=true;
  53.              if (parambuf[j]='1') then dens:=75;
  54.              if (parambuf[j]='2') then dens:=100;
  55.              if (parambuf[j]='3') then dens:=150;
  56.              if (parambuf[j]='4') then dens:=300;
  57.              if ( (parambuf[j]='c') or (parambuf[j]='C')) then cflag:=true;
  58.            end;
  59.           end else Infilename:=parambuf;
  60.         end;
  61.         Assign(InFile,InfileName);
  62.         {$I-}
  63.         Reset(InFile);
  64.         {$I+}
  65.         if (IOresult <> 0) then
  66.         begin
  67.            Writeln('Unable to open ',infilename);
  68.            halt;
  69.         end;
  70.         if cflag then Assign(Out,'AUX:')
  71.         else assign(Out,'LST:');
  72.         reset(out);
  73.         EndFile:=False;
  74.         if not dens in [75, 100, 150,300] then dens := 75;
  75.         resethp(true);
  76.      end else
  77.      begin
  78.         writeln;
  79.         Writeln('IBM2HPJ: Print IBM Graphics Printer File on HP Laserjet');
  80.         writeln('   by Sally Sheridan and Mark Lewis');
  81.         writeln('   Version 1.01  June, 1986');
  82.         Writeln;
  83.         writeln('usage:IBM2HPJ [-k1234] filename');
  84.         writeln('      -k     Keep the file (default is to delete when done');
  85.         writeln('      -1     Use 75 DPI density');
  86.         writeln('      -2     Use 100 DPI density (Default)');
  87.         writeln('      -3     Use 150 DPI density');
  88.         writeln('      -4     Use 300 DPI density');
  89.         writeln('      -c     Output to COM1 (default is PRN)');
  90.         writeln;
  91.         halt;
  92.      end;
  93.   end;
  94.  
  95. Procedure GrafMod480;  {have read in ESC K}
  96.   VAR
  97.     OutBuff : Array [1..8] of string[120];
  98.     outbufx : array [1..8,0..120] of byte absolute outbuff;
  99.     Maxoutbyte : Byte;
  100.     MAxInByte : integer;
  101.     BytePtr, LinePtr : Integer;
  102.     N1, N2 : Integer;
  103.     ist : String[3];
  104.     Temp : Byte;
  105.  
  106. Procedure Scanout;
  107. var j : Integer;
  108. begin
  109.     OutBufx[Lineptr][0]:=MaxOutByte;
  110.     if (scans mod 6 <> 0) then
  111.     begin
  112.         If saveflg then
  113.         begin
  114.            for j:=1 to length(savebuff) do
  115.              outbufx[lineptr][j]:=outbufx[lineptr][j] or savebufx[j];
  116.            if length(savebuff) > length(outbuff[lineptr]) then
  117.              Outbufx[Lineptr][0]:=length(savebuff);
  118.            saveflg:=false;
  119.            savebuff:='';
  120.         end;
  121.         Str(maxoutbyte,ist);
  122.         Write(out,^['*b'+ist+'W'); {ESC*b # W transfer a line}
  123.         Write(out,OutBuff[LinePtr]);
  124.      end else
  125.      begin
  126.          savebuff := outbuff[lineptr];
  127.          saveflg := true;
  128.      end;
  129. end;
  130.  
  131.  
  132.   begin
  133.   { compute number of bytes to read in and write out}
  134.     Read(InFile,InBuff);
  135.     N1:=InBuff;
  136.     Read(InFile,InBuff);
  137.     N2:=InBuff;
  138.     MaxInByte:= n1 + (256*N2);
  139.  
  140.   { clear OutBuff array}
  141.     MaxOutByte:= MaxInByte div 8;
  142.     if (Maxinbyte mod 8)<>0 then maxoutbyte:=Maxoutbyte +1;
  143.     for n1 := 1 to 8 do
  144.         Outbuff[n1]:=nullstr;
  145.     BytePtr := 1;
  146.  
  147.   { fill OutBuff array }
  148.     N2:=0;
  149.     FOR N1 := 1 to MaxInByte DO
  150.       Begin
  151.         Read(InFile,InBuff);
  152.         For LinePtr := 8 downto 1 do
  153.           begin
  154.             Temp:=OutBufx[LinePtr][BytePtr];
  155.             Temp:= Temp shl 1;
  156.             If odd(InBuff) Then
  157.               Temp:=Temp+1;
  158.             OutBufx[LinePtr][BytePtr]:= Temp;
  159.             InBuff:= InBuff shr 1;
  160.           end;
  161.         N2:=N2+1;
  162.         If (N2=8) then
  163.           Begin
  164.             BytePtr:= BytePtr +1;
  165.             N2:=0;
  166.           End;
  167.       End;
  168.     { Case of incomplete output byte}
  169.     If n2 <> 0 then
  170.     begin
  171.       n2:=8 - n2;
  172.       for lineptr := 1 to 8 do
  173.       begin
  174.          Temp:=outbufx[lineptr][byteptr];
  175.          temp := temp shl n2;
  176.          outbufx[lineptr][byteptr]:=temp;
  177.       end;
  178.     end;
  179.     { write OutBuff lines }
  180. {$U+}
  181.     write(out,^['&a5C');
  182.     write(out,^['*r1A');
  183.     for LinePtr := 1 to 8 do
  184.       begin
  185.         scans:=scans+1;
  186.         scanout;
  187.       end;
  188.     write(out,^['*rB'); {ESC*rB end raster graphics}
  189. {$U-}
  190.   end; {proc GrafMod480}
  191.  
  192.  
  193. Procedure Parse;
  194. begin
  195.    case inbuff of
  196.    12 : begin {FF}
  197.          resethp(true);
  198.         end;
  199.    26: begin {^Z EOF}
  200.          endfile:=true;
  201.        end;
  202.    27 : Begin
  203.          Read(InFile,InBuff);
  204.          If (InBuff=75) Then
  205.          begin
  206.             If pixflg then
  207.             begin
  208.               writeln('Printing picture ',pix);
  209.               pixflg:=false;
  210.             end;
  211.             GrafMod480;
  212.          end;
  213.         end;
  214.    end;
  215. END; {parse proc}
  216.  
  217. Begin
  218.   pix:=0;
  219.   saveflg:=false;
  220.   savebuff:='';
  221.   nullstr:='';
  222.   for j:=1 to 120 do nullstr:=Nullstr + char(0);
  223.   InitFiles;
  224.   repeat
  225.     Read(InFile,InBuff);
  226.     Parse;
  227.   until Endfile;
  228.   resethp(false);
  229.   Close(Infile);
  230.   if not keep then erase(infile);
  231.   close(out);
  232. End.
  233.